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— AlFont.mesa Edited by: Sandman, October 13, 1977 3:20 PM 

DIRECTORY 

FontDefs: FROM "FontDefs", 
InlineDefs: FROM "InlineDefs", 
Mopcodes: FROM "Mopcodes", 
SystemDefs: FROM "SystemDef s" , 
SegmentDefs: FROM "SegmentDefs"; 

DEFINITIONS FROM FontDefs; 

AlFont: PROGRAM IMPORTS SegmentDefs, SystemDefs EXPORTS FontDefs = 
BEGIN 

FileSegmentHandle: TYPE = SegmentDefs. FileSegmentHandle; 

CR: CHARACTER « 15C; 
SP: CHARACTER = • ; 

AlFontObject: TYPE = RECORD [ 
procs: FontObject, 
seg: FileSegmentHandle, 
lockCount: CARDINAL, 
height: CARDINAL]; 

AlFontHandle: TYPE = POINTER TO AlFontObject; 

FHptr: TYPE = POINTER TO FontHeader; 
Fptr: TYPE = POINTER TO Font; 
FCDptr: TYPE ■ POINTER TO FCD; 
FAptr: TYPE = POINTER TO FontArray; 
FontArray: TYPE = ARRAY [0..255] OF FCDptr; 

Font: TYPE = MACHINE DEPENDENT RECORD [ 
header: FontHeader, 
FCDptrs: FontArray, — array of self-relative pointers to 

-- FCD's. Indexed by char value, 

-- font pointer points hear! 
extFCDptrs: FontArray -- array of self-relative pointers to 

-- FCD's for extentions. As large an 

-- array as needed. 

]; 

FontHeader: TYPE » MACHINE DEPENDENT RECORD 

maxHeight: CARDINAL, — height of tallest char in font (scan lines) 
variableWidth: BOOLEAN, — IF TRUE, proportionally spaced font 
blank: [0..177B], — not used 
maxWidth: [0..377B] -- width of widest char in font (raster units). 

]! 

FCD: TYPE = MACHINE DEPENDENT RECORD [ 

widthORext: [0..77777B], -- width or extention index 
hasNoExtension: BOOLEAN, -- TRUE=> no ext . ; prevf ield=width 
height: [0..377B], -- # scan lines to skip for char 

displacement: [0..377B] -- displacement back to char bitmap 

]; 

CharWidth: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER] RETURNS [w: CARDINAL] 
BEGIN 

code: CARDINAL; 
cw: FCDptr; 
fontdesc: FAptr; 
-- checkfor control characters 
IF char = CR THEN char <- SP; 
IF char < SP THEN 

RrTURN[CharWidth[font, '*] + 
CharWidth[font, 

LOOPHOl r [ LOOPHOLE [ char, CARDINAL]* 1 00B , CHARACTER]]]; 
w <- 0; 

fontdesc <- 01 ockTon t[font] . FCDptrs ; 
code «- LOOPIIOLF[char]; 
DO 

cw *- I OOPHOl E[fontdesc[code] + l OOPHOLF[f ontdesc , CARDINAL ] + code] ; 
TF cw.hasNofxLension THEN FXIT; 
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w «• w+16; 

code «- cw.widthORext; 

ENOLOOP; 
w «- w+cw.widthORext; 
UnlockFont[font]; 
RETURN 
END; 

CharHeight: PUBLIC PROCEDURE [font: FontHandle, char: CHARACTER] RETURNS [CARDINAL] 
BEGIN 

RETURN[LOOPHOLE[font,Al FontHandle]. height] 
END; 

CONVERT: MACHINE CODE 

[char: CHARACTER, font: FAptr, destWord: POINTER, 
scanLineLength: CARDINAL, destBit: [0..15]] 

RETURNS [width: CARDINAL, newdestBit: [0..15], newdestWord: POINTER] » 
INLINE [Mopcodes.zCONVERT]; 

PaintChar: PROCEDURE 

[font: FontHandle, char: CHARACTER, bmState: POINTER TO BitmapState] = 

« note funny y-1 due to use of CONVERT! 

BEGIN OPEN bmState; 

dba: CARDINAL * Inl ineDef s. BITAND[Inl ineDef s . BITNOT[x] , 17B]; 

wad: POINTER = origin+(x/16)+(y-l)*wordsPerLine; 

pfont: FAptr = @LockFont[font] . FCDptrs ; 

cwidth: CARDINAL = CONVERT[char , pfont, wad, wordsPerLine , dba]. width; 

UnlockFont[font]; 

x <- x + cwidth; 

RETURN 

END; 

ClearChar: PROCEDURE 

[font: FontHandle, char: CHARACTER, bmState: POINTER TO BitmapState] = 

BEGIN OPEN bmState, InlineDefs; 

bit: [0..15]; 

xword: CARDINAL; 

scanLines: CARDINAL ■ LOOPHOLE[font,Al FontHandle] . height; 

start, p: POINTER; 

cwidth: INTEGER «- CharWidth[f ont , char] ; 

mask: WORD; 

ones: WORD = 177777B; 

IF x < cwidth THEN BEGIN cwidth <- x; x ♦- END 

ELSE x <- x - cwidth; 

xword <- x/16; bit «- x MOD 16; 

mask <- BITOR[BITSHIFT[ones,16-bit],BITSHIFT[ones,-(bit+cwidth)]]; 

start «- origin + xword + y*wordsPerLine-l; 

cwidth *- cwidth + bit; 

DO 

p «• start ♦• start + 1; 

THROUGH [0. .scanLines) DO 
pt <- BITAND[pt,mask]; 
p «- p + wordsPerLine; 
ENDLOOP; 

IF (cwidth ♦• cwidth - 16) <= THEN EXIT; 

mask <- BITSHIFT[ones, -cwidth]; 

ENDLOOP; 
RETURN 
END; 

LockFont: PROCEDURE [font: FontHandle] RETURNS [Fptr] = 
BEGIN OPEN SegmentDefs, af: LOOPHOLE[font.Al FontHandle] ; 
IF (af .lockCount ♦■ af.lockCount + 1) = 1 THEN Swapln[af . seg] ; 
RFTURN[F ileSegmentAddress[af . seg]] 
END; 

UnlockFont: PROCEDURC [font: FontHandle] = 

BTGIN OPFN SegmentDefs, af: LOOPHOl E[fon t . Al Tontllandle] ; 

IT (af.lockCount ♦• af.lockCount - 1) = THEN Unl ock[af . seg] ; 

RETURN 

END; 

DestroyTont: PROCEDURF [font: FontHandle] = 
BEGTN 

Closeront[fon t] ; 
Sys LemDefs . FreeHeapNode[font] ; 
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RETURN 
END; 

CloseFont: PROCEDURE [font: FontHandle] * 
BEGIN OPEN af: LOOPHOLE[font,AlFontHandle]; 
IF af.seg.1ock = THEN SegmentDef s.SwapOut[af .seg]; 
RETURN 
END; 

CreateFont: PUBLIC PROCEDURE 

[fontSegment: FileSegmentHandle] RETURNS [f: FontHandle] a 
BEGIN 

p: AlFontHandle = SystemDef s .AllocateHeapNode[SIZE[AlFontObject]] ; 
f <- LOOPHOLE[p]; 
pt <- [ 
procs: [ 

liaintChar: PaintChar, 
clearChar: ClearChar, 
charWidth: CharWidth, 
charHeight: CharHeight, 
close: CloseFont, 
destroy: DestroyFont, 
lock: LockFont, 
unlock: UnlockFont], 
seg: fontSegment, 
"lockCount: 0, 

height: LockFont[f ]. header. maxHeight]; 
UnlockFont[f]; 
RETURN 
END; 

END. 



